home *** CD-ROM | disk | FTP | other *** search
/ Festival Card Factory / Festival Card Factory.iso / imagewin.pas < prev    next >
Pascal/Delphi Source File  |  1995-12-25  |  4KB  |  136 lines
  1. unit ImageWin;
  2.  
  3. interface
  4.  
  5. uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls,
  6.   FileCtrl, StdCtrls, ExtCtrls, Buttons, Spin,graphwin;
  7.  
  8. type
  9.   TImageForm = class(TForm)
  10.     DirectoryListBox1: TDirectoryListBox;
  11.     DriveComboBox1: TDriveComboBox;
  12.     PathLabel: TLabel;
  13.     FileEdit: TEdit;
  14.     UpDownGroup: TGroupBox;
  15.     SpeedButton1: TSpeedButton;
  16.     BitBtn1: TBitBtn;
  17.     DisabledGrp: TGroupBox;
  18.     SpeedButton2: TSpeedButton;
  19.     BitBtn2: TBitBtn;
  20.     Panel1: TPanel;
  21.     Image1: TImage;
  22.     FileListBox1: TFileListBox;
  23.     Label1: TLabel;
  24.     SpinEdit1: TSpinEdit;
  25.     Label2: TLabel;
  26.     ViewBtn: TBitBtn;
  27.     Bevel1: TBevel;
  28.     Bevel2: TBevel;
  29.     FilterComboBox1: TFilterComboBox;
  30.     CheckBox1: TCheckBox;
  31.     StretchCheck: TCheckBox;
  32.     Button1: TButton;
  33.     Button2: TButton;
  34.     Bevel3: TBevel;
  35.     procedure FileListBox1Click(Sender: TObject);
  36.     procedure SpinEdit1Change(Sender: TObject);
  37.     procedure ViewBtnClick(Sender: TObject);
  38.     procedure ViewAsGlyph(const FileExt: string);
  39.     procedure CheckBox1Click(Sender: TObject);
  40.     procedure StretchCheckClick(Sender: TObject);
  41.     procedure FileEditKeyPress(Sender: TObject; var Key: Char);
  42.     procedure Button1Click(Sender: TObject);
  43.     procedure Button2Click(Sender: TObject);
  44.   end;
  45.  
  46. var
  47.   ImageForm: TImageForm;
  48.   cmd:array[0..255] of char;
  49.  
  50.  
  51. implementation
  52.  
  53. uses ViewWin, SysUtils;
  54.  
  55. {$R *.DFM}
  56.  
  57. procedure TImageForm.FileListBox1Click(Sender: TObject);
  58. var
  59.   FileExt: string[4];
  60. begin
  61.   FileExt := UpperCase(ExtractFileExt(FileListBox1.Filename));
  62.   if (FileExt = '.BMP') or (FileExt = '.ICO') or (FileExt = '.WMF') then
  63.   begin
  64.     Image1.Picture.LoadFromFile(FileListBox1.Filename);
  65.     Label1.Caption := ExtractFilename(FileListBox1.Filename);
  66.     if (FileExt = '.BMP') then
  67.     begin
  68.       Label1.Caption := Label1.Caption + 
  69.         Format(' (%d x %d)', [Image1.Picture.Height, Image1.Picture.Width]);
  70.       ViewForm.Image1.Picture := Image1.Picture;
  71.       ViewAsGlyph(FileExt);
  72.     end;
  73.     if FileExt = '.ICO' then Icon := Image1.Picture.Icon;
  74.     if FileExt = '.WMF' then 
  75.       ViewForm.Image1.Picture.Metafile := Image1.Picture.Metafile;
  76.   end;
  77. end;
  78.  
  79. procedure TImageForm.CheckBox1Click(Sender: TObject);
  80. begin
  81.   ViewAsGlyph(UpperCase(ExtractFileExt(FileListBox1.Filename)));
  82. end;
  83.  
  84. procedure TImageForm.ViewAsGlyph(const FileExt: string);
  85. begin
  86.   if CheckBox1.Checked and (FileExt = '.BMP') then 
  87.   begin
  88.     SpeedButton1.Glyph := Image1.Picture.Bitmap;
  89.     SpeedButton2.Glyph := Image1.Picture.Bitmap;
  90.     SpinEdit1.Value := SpeedButton1.NumGlyphs;
  91.     BitBtn1.Glyph := Image1.Picture.Bitmap;
  92.     BitBtn2.Glyph := Image1.Picture.Bitmap;
  93.   end;
  94. end;
  95.  
  96. procedure TImageForm.ViewBtnClick(Sender: TObject);
  97. begin
  98.   ViewForm.HorzScrollBar.Range := Image1.Picture.Width;
  99.   ViewForm.VertScrollBar.Range := Image1.Picture.Height;
  100.   ViewForm.Caption := Label1.Caption;
  101.   ViewForm.Show;
  102. end;
  103.  
  104. procedure TImageForm.SpinEdit1Change(Sender: TObject);
  105. begin
  106.   SpeedButton1.NumGlyphs := SpinEdit1.Value;
  107.   SpeedButton2.NumGlyphs := SpinEdit1.Value;
  108. end;
  109.  
  110. procedure TImageForm.StretchCheckClick(Sender: TObject);
  111. begin
  112.   Image1.Stretch := StretchCheck.Checked;
  113. end;
  114.  
  115. procedure TImageForm.FileEditKeyPress(Sender: TObject; var Key: Char);
  116. begin
  117.   if Key = #13 then 
  118.   begin
  119.     FileListBox1.ApplyFilePath(FileEdit.Text);
  120.     Key := #0;
  121.   end;
  122. end;
  123.  
  124. procedure TImageForm.Button1Click(Sender: TObject);
  125. begin
  126.      form1.show;
  127. end;
  128.  
  129. procedure TImageForm.Button2Click(Sender: TObject);
  130. begin
  131. strpcopy(cmd, 'c:\windows\pbrush.exe');
  132. winExec(cmd, sw_showmaximized);
  133. end;
  134.  
  135. end.
  136.